unit uXMLStream ;

interface

uses
   Classes ;

type
   TXMLState = (
      xmlNone,
      xmlProlog,
      xmlTag,
      xmlTagEnd,
      xmlAttribute,
      xmlCharData ) ;

   TStringStack = class( TStringlist )
   private
   public
      procedure Push( aString : string ) ;
      function Pop : string ;
   end ;

   TXMLWriter = class
   private
      fStream : TStream ;
      fState : TXMLState ;
      fTags : TStringStack ;
      fFirstColumn : boolean ;
      fIndentStep : integer ;
      procedure WriteString( aString : string ) ;
      procedure CloseTagStart( aSelfClosed : boolean = False ) ;
      function Indent : string ;
   public
      constructor Create( const aStream : TStream ) ;
      destructor Destroy ; override ;

      procedure Tag( const aName : string ) ; virtual ;
      procedure Attribute( const aAttr, aData : string ) ; virtual ;
      procedure EndTag( const aTag : string = '' ) ; virtual ;
      procedure CharData( const aString : string ) ; virtual ;
      procedure Comment( const aString : string ) ; virtual ;
      property IndentStep : integer read fIndentStep write fIndentStep default 2 ;
   end ;

   TXMLReader = class
   private
      fStream : TStream ;
   public
      constructor Create( const aStream : TStream ) ;
      destructor Destroy ; override ;
   end ;

const
   versionMajor     = '1' ;
   versionMinor     = '0' ;

implementation

uses
   SysUtils ;

{ TXMLWriter }

procedure TXMLWriter.Attribute( const aAttr, aData : string ) ;
begin
   if fState = xmlAttribute then
      WriteString( '"' ) ;
   if fState <> xmlNone then begin
      WriteString( ' ' + aAttr + '="' + aData ) ;
      fState := xmlAttribute ;
   end ;
   // else throw some error - unexpected attribute (out of any tag)
end ;

procedure TXMLWriter.CharData( const aString : string ) ;
begin
   CloseTagStart ;
   fState := xmlNone ;
   WriteString( aString + #13#10 ) ;
end ;

procedure TXMLWriter.CloseTagStart( aSelfClosed : boolean = False ) ;
begin
   if fState = xmlAttribute then
      WriteString( '"' ) ;
   if fState in [ xmlAttribute, xmlTag ] then begin
      if aSelfClosed then
         WriteString( '/' ) ;
      WriteString( '>'#13#10 ) ;
   end ;
end ;

procedure TXMLWriter.Comment( const aString : string ) ;
begin
   if fState = xmlNone then
      WriteString( '<!-- ' + aString + ' --> '#13#10 ) ;
end ;

constructor TXMLWriter.Create( const aStream : TStream ) ;
begin
   inherited Create ;
   fStream := aStream ;
   fIndentStep := 2 ;
   fTags := TStringStack.Create ;
   WriteString( '<?xml version="' + versionMajor + '.' + versionMinor + '"?>'#13#10 ) ;
end ;

destructor TXMLWriter.Destroy ;
begin
   fTags.Free ;
   inherited ;
end ;

procedure TXMLWriter.EndTag( const aTag : string = '' ) ;
var
   brk              : boolean ;
   Top              : string ;
begin
   brk := false ;
   while ( fTags.Count > 0 ) and ( not brk ) do begin
      Top := fTags.Pop ;
      if fState = xmlNone then
         WriteString( '</' + Top + '>'#13#10 )
      else begin
         CloseTagStart( True ) ;
         fState := xmlNone ;
      end ;
      brk := ( aTag = '' ) or ( aTag = Top ) ;
   end ;
end ;

function TXMLWriter.Indent : string ;
begin
   Result := StringOfChar( ' ', fTags.Count * fIndentStep ) ;
end ;

procedure TXMLWriter.Tag( const aName : string ) ;
begin
   CloseTagStart ;
   WriteString( '<' + aName ) ;
   fTags.Push( aName ) ;
   fState := xmlTag ;
end ;

procedure TXMLWriter.WriteString( aString : string ) ;
var
   Buffer           : array[ 0..1023 ] of Char ;
begin
   if fFirstColumn then
      aString := Indent + aString ;
   fFirstColumn := Pos( #13, aString ) > 0 ;
   StrCopy( Buffer, PChar( aString ) ) ;
   if assigned( fStream ) then
      fStream.WriteBuffer( Buffer, length( aString ) ) ;
end ;

{ TStringStack }

function TStringStack.Pop : string ;
begin
   Result := Strings[ Count - 1 ] ;
   Delete( Count - 1 ) ;
end ;

procedure TStringStack.Push( aString : string ) ;
begin
   Add( aString ) ;
end ;

{ TXMLReader }

constructor TXMLReader.Create( const aStream : TStream ) ;
begin
   inherited Create ;
   fStream := aStream ;
end ;

destructor TXMLReader.Destroy ;
begin
   inherited ;
end ;

end.

